home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Complete Applications / 4D Programming / External Procedures / Soundex Stuff / Soundex.p < prev    next >
Encoding:
Text File  |  1987-11-20  |  1.4 KB  |  84 lines  |  [TEXT/ttxt]
  1. Program SoundParser;
  2.  
  3. Uses
  4. Memtypes, Quickdraw, OSIntf, Toolintf, PackIntf;
  5. {$D+}
  6. {$R-}
  7.  
  8. Var
  9. Dummy1:str255;
  10.  
  11.  
  12.  
  13. Procedure Parse(var First:str255);
  14. Var
  15. namelength, resultlen, lastcount, count, vcount:longint;
  16. name, trans, zero, testchar:str255;
  17. vset:Array[0..6] of str255;
  18. found, done:Boolean;
  19.  
  20.  
  21. Begin
  22.  
  23. {Load the array's with similar sounds.}
  24.  
  25. vset[0]:='AEHIOUWYaehiouwy';
  26. vset[1]:='BFPVbfpv';
  27. vset[2]:='CGJKQSXZcgjkqsxz';
  28. vset[3]:='DTdt';
  29. vset[4]:='Ll';
  30. vset[5]:='MNmn';
  31. vset[6]:='Rr';
  32.  
  33. {Initialize remaining variables.}
  34.  
  35. resultlen:=0;
  36. lastcount:=0;
  37. namelength:=Length(First)-1;
  38. name:=Copy(First,2,namelength);
  39. count:=0;
  40. done:=False;
  41. zero:='';
  42.  
  43. While ((count<namelength)&(Not(done))) do
  44.  begin
  45.   count:=count+1;
  46.   testchar:=Copy(name,count,1);
  47.   found:=False;
  48.   vcount:=-1;
  49.   While ((vcount<6)&(Not(found))) do
  50.    Begin
  51.     vcount:=vcount+1;
  52.     If ((Pos(testchar,vset[vcount]))>0) then
  53.       found:=True;
  54.    End;
  55.    
  56.   If (Not(found)) then
  57.     vcount:=0;
  58.   
  59.   If ((vcount<>0)&(lastcount<>vcount)) then
  60.   Begin
  61.     NumToString(vcount, trans);
  62.     Zero:=Concat(Zero, trans);
  63.     resultlen:=resultlen+1;
  64.     If (resultlen=3) then
  65.       done:=True;
  66.    End;
  67.   lastcount:=vcount;
  68. End;
  69.  
  70. While (resultlen<3) do
  71.  Begin
  72.   resultlen:=resultlen+1;
  73.   Zero:=Concat(Zero, '0')
  74.  End;
  75.  
  76.  {Put first character in front of computed code.}
  77.  
  78.  First:=Concat(Copy(First,1,1),Zero);
  79.  
  80. end;
  81.  
  82. Begin
  83.  Parse(Dummy1)
  84. End.